home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / modula2 / module / xbios104.mod < prev   
Encoding:
Modula Implementation  |  1995-11-25  |  9.6 KB  |  353 lines
  1. IMPLEMENTATION MODULE  XBIOS104;
  2. (* --------------------------------------------------------------
  3.          XBIOS - Modula interface to Atari extended BIOS functions
  4.    -------------------------------------------------------------------- *)
  5.  
  6. FROM SYSTEM IMPORT BYTE, ADDRESS,VAL,ADR,REG,WORD;
  7.  
  8. FROM TRAPdefs IMPORT d0,
  9.                      XBIOS0, XBIOS1w, XBIOS2w, XBIOS6w, XBIOS1l, XBIOS3l,
  10.                      XBIOS1w1l, XBIOS1w2l, XBIOS3w1l, XBIOS1l1w, XBIOS2l1w,
  11.                      XBIOS2l2w, XBIOS2l5w, XBIOS2l5w1l1w ;
  12.  
  13. PROCEDURE InitMouse(type: INTEGER; VAR  param: ParamBlk;  vec: PROC);
  14.   (* initialise mouse packet handler. *)
  15. BEGIN
  16.   XBIOS1w2l(VAL(LONGCARD,ADR(vec)), VAL(LONGCARD,ADR(param)), type,0);
  17. END InitMouse;
  18.  
  19. PROCEDURE ScreenPhysicalBase(): ADDRESS;
  20.   (* get the screen's physical base address at beginning of next vblank. *)
  21. BEGIN
  22.    XBIOS0(2);
  23.    RETURN VAL(ADDRESS,REG(d0));
  24. END ScreenPhysicalBase;
  25.  
  26. PROCEDURE ScreenLogicalBase(): ADDRESS;
  27.   (* get the screen's logical (GSX) base address. *)
  28. BEGIN
  29.    XBIOS0(3);
  30.    RETURN VAL(ADDRESS,REG(d0));
  31. END ScreenLogicalBase;
  32.  
  33. PROCEDURE GetResolution(): INTEGER;
  34.   (* return the screen's current resolution*)
  35. BEGIN
  36.    XBIOS0(4);
  37.    RETURN VAL(INTEGER,REG(d0));
  38. END GetResolution;
  39.  
  40. PROCEDURE SetScreenBase(logLoc, physLoc: ADDRESS; rez: INTEGER);
  41.   (* set screen base address and resolutions.*)
  42. BEGIN
  43.    XBIOS2l1w(rez,VAL(LONGCARD,physLoc),VAL(LONGCARD,logLoc),5);
  44. END SetScreenBase;
  45.  
  46. PROCEDURE SetPalette(VAR palette: Palette);
  47.   (* set the contents of the hardware palette register. *)
  48. BEGIN
  49.    XBIOS1l(ADR(palette),6);
  50. END SetPalette;
  51.  
  52. PROCEDURE SetColour(colourNum, colour: CARDINAL): CARDINAL;
  53.   (* set the colour of a palette table entry.*)
  54. BEGIN
  55.    XBIOS2w(colour,colourNum,7);
  56.    RETURN VAL(CARDINAL,REG(d0))
  57. END SetColour;
  58.  
  59. PROCEDURE FloppyRead(buf: ADDRESS; drive: CARDINAL;
  60.                      sector, track, side: CARDINAL;
  61.                      count: CARDINAL):INTEGER;
  62.   (* read floppy disk sector(s) into buffer.*)
  63. BEGIN
  64.     XBIOS2l5w(count,side,track,sector,drive,0D,VAL(LONGCARD,buf),8);
  65.     RETURN VAL(INTEGER,REG(d0))
  66. END FloppyRead;
  67.  
  68. PROCEDURE FloppyWrite(buf: ADDRESS; drive: CARDINAL;
  69.                       sector, track, side: CARDINAL;
  70.                       count: CARDINAL): INTEGER;
  71.   (* write buffer to floppy disk sector(s).*)
  72. BEGIN
  73.     XBIOS2l5w(count,side,track,sector,drive,0D,VAL(LONGCARD,buf),9);
  74.     RETURN VAL(INTEGER,REG(d0))
  75. END FloppyWrite;
  76.  
  77. PROCEDURE FloppyFormat(buf: ADDRESS; drive: CARDINAL;
  78.                        spt, track, side: CARDINAL;
  79.                        interleave, virgin: CARDINAL): INTEGER;
  80.   (* format a floppy disk track.*)
  81. CONST Magic = 87654321H;
  82. BEGIN
  83.     XBIOS2l5w1l1w(virgin,Magic,interleave,side,track,spt,drive,0D,VAL(LONGCARD,buf),10);
  84. END FloppyFormat;
  85.  
  86. PROCEDURE MIDIWS(VAR string: ARRAY OF BYTE; len: CARDINAL);
  87.   (* write a string of characters to the MIDI port.*)
  88. BEGIN
  89.   XBIOS1l1w(len,VAL(LONGCARD,ADR(string)),12);
  90. END MIDIWS;
  91.  
  92. PROCEDURE MFPint(intNo: CARDINAL; vector: PROC);
  93.   (* set MFP interrupt vector.*)
  94. BEGIN
  95.   XBIOS1w1l(VAL(LONGCARD,ADR(vector)),intNo,13);
  96. END MFPint;
  97.  
  98. PROCEDURE IORec(dev: INTEGER): IORECPTR;
  99.   (* return pointer to serial device IO record.*)
  100. BEGIN
  101.    XBIOS1w(dev,14);
  102.    RETURN VAL(ADDRESS, REG(d0))
  103. END IORec;
  104.  
  105. PROCEDURE ConfigureRS232(speed,
  106.                          flowctl,
  107.                          ucr, rsr, tsr, scr: INTEGER);
  108.   (* configure RS232 port.*)
  109. BEGIN
  110.    XBIOS6w(scr,tsr,rsr,ucr,flowctl,speed,15);
  111. END ConfigureRS232;
  112.  
  113. PROCEDURE SetKeyTable(VAR unshift, shift, capslock: KeyTransPtr):
  114.                                                           KeyTablePtr;
  115.   (* set pointers to keyboard translation tables. *)
  116. VAR Shift,UnShift,CapsLock :LONGCARD;
  117. BEGIN
  118.    Shift:=VAL(LONGCARD,shift);
  119.    UnShift:=VAL(LONGCARD,unshift);
  120.    CapsLock:=VAL(LONGCARD,capslock);
  121.    XBIOS3l(CapsLock,Shift,UnShift,16);
  122.    shift:=VAL(ADDRESS,Shift);
  123.    unshift:=VAL(ADDRESS,UnShift);
  124.    capslock:=VAL(ADDRESS,CapsLock);
  125.    RETURN VAL(ADDRESS,REG(d0));
  126. END SetKeyTable;
  127.  
  128.  
  129. PROCEDURE Random(): LONGCARD;
  130.   (* return a random number. *)
  131. BEGIN
  132.    XBIOS0(17);
  133.    RETURN REG(d0);
  134. END Random;
  135.  
  136. PROCEDURE PrototypeBootSector(buf: ADDRESS; serialNo: LONGINT;
  137.                               disktype: INTEGER; execFlag: INTEGER);
  138.   (* prototype an image of a boot sector.*)
  139. BEGIN
  140.    XBIOS2l2w(execFlag,disktype,VAL(LONGCARD,serialNo),VAL(LONGCARD,buf),18);
  141. END PrototypeBootSector;
  142.  
  143. PROCEDURE FloppyVerify(buf: ADDRESS; drive: CARDINAL;
  144.                        sector, track, side: CARDINAL;
  145.                        count: CARDINAL): INTEGER;
  146.   (* verify floppy disk sectors are readable.*)
  147. BEGIN
  148.    XBIOS2l5w(count,side,track,sector,drive,0D,VAL(LONGCARD,buf),19);
  149.    RETURN VAL(INTEGER,REG(d0));
  150. END FloppyVerify;
  151.  
  152. PROCEDURE ScreenDump;
  153.   (* dump screen to printer. *)
  154. BEGIN
  155.    XBIOS0(20);
  156. END ScreenDump;
  157.  
  158. PROCEDURE ConfigureCursor(rate, attrib: INTEGER): INTEGER;
  159.   (* configure cursor blink rate and attributes,*)
  160. BEGIN
  161.   XBIOS2w(attrib,rate,15H);
  162.   RETURN VAL(INTEGER,REG(d0))
  163. END ConfigureCursor;
  164.  
  165. PROCEDURE SetDateTime(datetime: LONGCARD);
  166.   (* set keyboard date and time.*)
  167. BEGIN
  168.   XBIOS1l(datetime,16H);
  169. END SetDateTime;
  170.  
  171. PROCEDURE GetDateTime (): LONGCARD;
  172.   (* get the date and time.*)
  173. BEGIN
  174.   XBIOS0(17H);
  175.   RETURN VAL(LONGCARD,REG(d0));
  176. END GetDateTime;
  177.  
  178. PROCEDURE BiosKeys;
  179.   (* restore keymappings to power up settings *)
  180. BEGIN
  181.    XBIOS0(18H);
  182. END BiosKeys;
  183. PROCEDURE KeyboardWS(VAR str: ARRAY OF BYTE; len: CARDINAL);
  184.   (* write string to intelligent keyboard.*)
  185. BEGIN
  186.   XBIOS1l1w(len,VAL(LONGCARD,ADR(str)),19H)
  187. END KeyboardWS;
  188.  
  189. PROCEDURE DisableInterrupt(intNo: CARDINAL);
  190.   (* diable given 68981 interrupt. *)
  191. BEGIN
  192.    XBIOS1w(intNo,1AH);
  193. END DisableInterrupt;
  194.  
  195. PROCEDURE EnableInterrupt(intNo: CARDINAL);
  196.   (* enable given 68981 interrupt. *)
  197. BEGIN
  198.    XBIOS1w(intNo,1BH);
  199. END EnableInterrupt;
  200.  
  201. PROCEDURE GIRead(regno: CARDINAL): CARDINAL;
  202.   (* read register on the sound chip.*)
  203. BEGIN
  204.    XBIOS1w(regno,1CH);
  205.    RETURN VAL(CARDINAL,REG(d0));
  206. END GIRead;
  207.  
  208.  
  209. PROCEDURE GIWrite(regno, data: CARDINAL);
  210.   (* write register on the sound chip. *)
  211. BEGIN
  212.    XBIOS2w(regno+128,data,1CH);
  213. END GIWrite;
  214.  
  215. PROCEDURE GIOffBit(bitno: CARDINAL);
  216.   (* set a bit in the port A register to zero.*)
  217. BEGIN
  218.    XBIOS1w(bitno,1DH);
  219. END GIOffBit;
  220.  
  221. PROCEDURE GIOnBit(bitno: CARDINAL);
  222.   (* set a bit in the port A register to one.*)
  223. BEGIN
  224.    XBIOS1w(bitno,1EH);
  225. END GIOnBit;
  226.  
  227. PROCEDURE SetTimerInterrupt(timer: INTEGER;  control, data: CARDINAL;
  228.                                                        vec: PROC);
  229.   (* set an interrupt handler for timer.*)
  230. BEGIN
  231.    XBIOS3w1l(VAL(LONGCARD,ADR(vec)),data,control,timer,1FH);
  232. END SetTimerInterrupt;
  233.  
  234. PROCEDURE DoSound(x: ADDRESS);
  235.   (* set sound daemon's "program counter".*)
  236. BEGIN
  237.    XBIOS1l(VAL(LONGCARD,x),20H);
  238. END DoSound;
  239.  
  240. PROCEDURE ConfigurePrinter(config: PrtConfig): LONGCARD;
  241.   (* configure printer.*)
  242. BEGIN
  243.    XBIOS1l(VAL(LONGCARD,ADR(config)),21H);
  244.    RETURN REG(d0);
  245. END ConfigurePrinter;
  246.  
  247. PROCEDURE KeyboardVectors(): KBVectorPtr;
  248.   (* return pointer to keyboard vector table. *)
  249. BEGIN
  250.    XBIOS0(22H);
  251.    RETURN VAL(ADDRESS,REG(d0));
  252. END KeyboardVectors;
  253.  
  254. PROCEDURE KeyboardRate(initial, repeat: INTEGER): CARDINAL;
  255.   (* set keyboard repeat rate and delay.*)
  256.   (* parameter -1 liefert aktuelle Werte zurück*)
  257.  
  258. BEGIN
  259.    XBIOS2w(repeat,initial,23H);
  260.    RETURN VAL(CARDINAL,REG(d0));
  261. END KeyboardRate;
  262.  
  263. PROCEDURE PrintBlock (parameter: ADDRESS);
  264. BEGIN
  265.    XBIOS1l(VAL(LONGCARD,parameter),24H);
  266. END PrintBlock;
  267.  
  268. PROCEDURE VSync;
  269.   (* wait for next vertical blank interrupt. *)
  270. BEGIN
  271.    XBIOS0(25H);
  272. END VSync;
  273.  
  274. PROCEDURE SuperExec(Code: PROC);
  275.   (* Run code in supervisor mode with supervisor stack.*)
  276. BEGIN
  277.     XBIOS1l(VAL(LONGCARD,ADR(Code)),26H);
  278. END SuperExec;
  279.  
  280. PROCEDURE PuntAES;
  281.   (* Throws away the GEM AES, freeing up memory. A re-boot will always be
  282.      performed after this call (unless AES is in ROM) *)
  283. BEGIN
  284.    XBIOS0(27H);
  285. END PuntAES;
  286.  
  287. (*************************** Ab TOS 1.04 **********************************)
  288.  
  289. PROCEDURE FlopRate(drive,rate:INTEGER ):LONGINT;
  290. BEGIN
  291.    XBIOS2w(rate,drive,41);
  292.    RETURN REG(d0);
  293. END FlopRate;
  294. (*************************** Ab TOS 3.00 (TT-TOS) *************************)
  295. PROCEDURE DMARead( Sector : LONGCARD; Count : CARDINAL; buffer : PROC; DeviceNo: CARDINAL);
  296. BEGIN
  297. (*   XBIOS1l1w1l1w(42);*)
  298. END DMARead;
  299. PROCEDURE DMAWrite( Sector : LONGCARD; Count : CARDINAL; buffer : PROC; DeviceNo: CARDINAL);
  300. BEGIN
  301. (*   XBIOS0(43);*)
  302. END DMAWrite;
  303. PROCEDURE BConMap(DeviceNo:INTEGER):ADDRESS;
  304. BEGIN
  305.   XBIOS1w(DeviceNo,44);
  306.   RETURN VAL(ADDRESS, REG(d0));
  307. END BConMap;
  308.  
  309. PROCEDURE SetShiftModeRegister(Mode : LONGCARD);
  310. BEGIN
  311.    XBIOS1l(Mode,80);
  312. END SetShiftModeRegister;
  313.  
  314. PROCEDURE GetShiftModeRegister():LONGCARD;
  315. BEGIN
  316. XBIOS0(81);
  317.      RETURN REG(d0);
  318. END GetShiftModeRegister;
  319.  
  320. PROCEDURE ESetBank(RegNo,Color :INTEGER ): INTEGER;
  321. BEGIN
  322.    XBIOS2w(Color,RegNo,82);
  323. END ESetBank;
  324.  
  325. PROCEDURE ESetColor(RegNo,Count:CARDINAL);
  326. BEGIN
  327.     XBIOS2w(RegNo,Count,83);
  328. END ESetColor;
  329.  
  330. PROCEDURE EsetPalette(RegNo,Count:CARDINAL; Palette : ADDRESS);
  331. BEGIN
  332. (*    XBIOS2w1l(Palette,RegNo,Count,84);*)
  333. END EsetPalette;
  334.  
  335. PROCEDURE EGetPalette(RegNo,Count:CARDINAL;VAR  Palette : ADDRESS);
  336. BEGIN
  337. (*    XBIOS2w1l(Palette,RegNo,Count,85);*)
  338. END EGetPalette;
  339.  
  340. PROCEDURE EsetGray(Color :INTEGER):BOOLEAN;
  341. BEGIN
  342.      XBIOS1w(Color,86);
  343.      RETURN REG(d0)=1D;
  344. END EsetGray;
  345.  
  346. PROCEDURE ESetSmear(Mode :INTEGER):BOOLEAN;
  347. BEGIN
  348.    XBIOS1w(Mode,87);
  349.    RETURN REG(d0)=1D;
  350. END ESetSmear;
  351.  
  352. END XBIOS104.
  353.